home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / pert.arc / PERT.BAS next >
BASIC Source File  |  1986-04-26  |  13KB  |  268 lines
  1. 10 '     PROGRAM: ENHANCED PERT          SOURCE: BYTE, MAY, 1982, PG. 469ff.
  2. 20 '     FUNCTION: PERT-CHARTING         DATE:   5/1/82
  3. 30 '     VERSION:  1.1                   AUTHOR: T. V. BONOMA
  4. 40 '
  5. 42 SCREEN 0,1,0,0:WIDTH 80
  6. 45 DEFDBL M,X,P
  7. 47 KEY OFF
  8. 50 CLEAR 5000: CLS
  9. 60 WIDTH 80: COLOR 5,0,5:LOCATE 1,23:PRINT "PERT/CRITICAL PATH SCHEDULING"
  10. 70 LOCATE 3,23: COLOR 7: PRINT "ORIGINAL BY S.M. ZIMMERMAN/L.M. CONRAD"
  11. 80 LOCATE 5,23: COLOR 9: PRINT "MODIFIED/ADAPTED FOR IBM PC BY"
  12. 90 LOCATE 7,23: COLOR 15: PRINT "THOMAS V. BONOMA   MAY, 1982"
  13. 100 COLOR 7,0,0:PRINT:PRINT"Note:  Beginning Events will be sorted numerically"
  14. 105 LOCATE 12,1
  15. 110 FOR I= 1 TO 16: FOR J=1 TO 15:Q=J:IF Q >15 THEN Q =0
  16. 115 COLOR Q:PRINT CHR$(1);:NEXT J:NEXT I
  17. 120 DIM A$(500,2),A(500,11),SV(11)
  18. 130 CLS: LOCATE 5,25: COLOR 15,0,0: PRINT "MENU FOR INPUT CHOICES"
  19. 135 FOR HOLDIT = 1 TO 700:NEXT HOLDIT
  20. 140 COLOR 7,0,8: LOCATE 7,20: PRINT "K - Keyboard"
  21. 150 COLOR 3:LOCATE 8,20: PRINT "D - Disk File"
  22. 160 COLOR 11:LOCATE 9,20: PRINT "R - Read Statements already in program"
  23. 170 LOCATE 14,40:COLOR 15,0,0: INPUT "What is your selection  ";IO$
  24. 175 IF IO$<>"D" AND IO$<>"R" AND IO$<>"K" AND IO$<>"d" AND IO$<>"r" AND IO$<>"k"        THEN 130
  25. 180 COLOR 7,0,0: IF IO$<>"K" AND IO$<>"k" THEN 360
  26. 190 CLS: LOCATE 5,5: INPUT "How many different tasks do you have  ";M%:EE=0
  27. 200 COLOR  4,0,9:  PRINT: PRINT "OK...let's enter them one at a time.  For each, we'll want"
  28. 210 PRINT "an activity code, a description,  a beginning and ending 'event"
  29. 220 PRINT "   number', and optimistic and pessimistic completion estimates."
  30. 230 COLOR 8:PRINT: PRINT "Hit any key to enter data":COLOR 7,0,0
  31. 240 TR$=INPUT$(1)
  32. 250 CLS: COLOR 3,0,0: LOCATE 1,35: PRINT "DATA ENTRY ROUTINE"
  33. 260 COLOR 15,0,0: LOCATE 3,5: PRINT "Code":LOCATE 3,10:PRINT"Descript.": LOCATE     3,25:PRINT "Begin?":LOCATE 3,35:PRINT "End?":LOCATE 3,42:PRINT"Optimistic":     LOCATE 3,55:PRINT "Likely";:LOCATE 3,64:PRINT "Pessimistic"
  34. 270 X=4:COLOR 7,0,0
  35. 280 FOR I=1 TO M%
  36. 290 LOCATE X,7:INPUT"",A$(I,1):LOCATE X,11:INPUT "",A$(I,2):LOCATE X,27:INPUT       "",A(I,1):LOCATE X,36:INPUT "",A(I,2):LOCATE X,47:INPUT "",A(I,3):LOCATE        X,57:INPUT "",A(I,4):LOCATE X,69:INPUT "",A(I,5)
  37. 300 X=X+1
  38. 340 NEXT I
  39. 350  GOTO 460
  40. 360 IF IO$<>"D" AND IO$<>"d" THEN 470
  41. 370 CLS:LOCATE 5,30:COLOR 14,0,8:PRINT "DISK INPUT ROUTINE"
  42. 375 ON ERROR GOTO 15000
  43. 380 COLOR 7,0,8: PRINT:LINE INPUT "Name of disk file, e.g., B:xxxxxxx.yyy  ";           B$:OPEN "I",1,B$
  44. 400 INPUT#1, M%,EE
  45. 410 FOR I= 1 TO M%
  46. 420 INPUT#1, A$(I,1),A$(I,2),A(I,1), A(I,2), A(I,3),A(I,4),A(I,5)
  47. 430 IF A$(I,1)="END" THEN 540
  48. 440 NEXT I
  49. 450 CLOSE #1
  50. 460 GOTO 530
  51. 470 IF IO$<>"R" AND IO$<>"r" THEN 130
  52. 475 CLS:PRINT "Reading Data from Program....Please Wait.....":COLOR 7,0,0
  53. 480 READ M%,EE
  54. 490 FOR I=1 TO M%
  55. 500 READ A$(I,1),A$(I,2),A(I,1),A(I,2),A(I,3),A(I,4),A(I,5)
  56. 510 IF A$(I,1)="END" THEN 530
  57. 520 NEXT I
  58. 530 ' Verify the data which was entered.
  59. 540 M=M%: TP=0:FOR I = 1 TO M: IF A(I,2)>TP THEN TP=A(I,2)
  60. 550 NEXT I: EE= TP
  61. 560 FOR I=1 TO M-1
  62. 570 FOR J=I+1 TO M
  63. 580 IF A(I,1)<=A(J,1) THEN 610
  64. 590 FOR K=1 TO 11: SV(K)=A(I,K):A(I,K)=A(J,K):A(J,K)=SV(K):NEXT K
  65. 600 FOR K=1 TO 2: SV$(K)=A$(I,K):A$(I,K)=A$(J,K):A$(J,K)=SV$(K):NEXT K
  66. 610 NEXT J,I
  67. 620 CLS
  68. 630 XX=5: COLOR 14,0,0:PRINT TAB(25);"VERIFICATION OF INPUT":PRINT:COLOR 7,0,0
  69. 640 Z1$="Code Description   Expected  Early   Early    Last    Last   Slack"
  70. 650 Z2$="                    Time     Start    Fin.    Start   Fin.   Time"
  71. 660 Z3$="Code      Description          Begin    End    Optimist  Likely  Pessimist"
  72. 670 Z4$="                               Event   Event     Time     Time      Time  "
  73. 680 PRINT "No. ";Z3$
  74. 690 PRINT "    ";Z4$
  75. 700 K=0
  76. 710 C4$="### "
  77. 720 FOR I=1 TO M%
  78. 730 PRINT USING C4$;I;
  79. 740 C1$="  ####  "
  80. 750 C2$="\            \":C3$=" ####.## "
  81. 760 PRINT USING C2$;A$(I,1),A$(I,2);
  82. 770 FOR J=1 TO 2
  83. 780 PRINT USING C1$;A(I,J);:NEXT J
  84. 790 FOR J=3 TO 5
  85. 800 PRINT USING C3$;A(I,J);:NEXT J
  86. 810 K=K+1: IF K>=20 THEN MSG$ ="Enter to Page":LGTH=1:ANSWER$="":GOSUB 10000
  87. 820 PRINT: NEXT I
  88. 830 COLOR 7:  MSG$= "Please input a -2 to add more,-1 to continue, or number (E.G., 03) to change ":LGTH=2:GOSUB 10000:ANSWER=VAL(ANSWER$):L=ANSWER:IF L=-1 THEN 905
  89. 840 IF L<>-2 THEN 860
  90. 850 L=M%+1: M%=L:N%=N%+1:XCHECK=1:GOTO 860
  91. 860 IF L>M% THEN GOTO 830: ELSE GOSUB 20000:IF ABORT GOTO 830
  92. 865 INPUT "New Code Name/Letter or END to ABORT  ";A$(L,1)
  93. 867 IF A$(L,1)="END" THEN GOSUB 22000:GOTO 830
  94. 870 INPUT "New Description  ";A$(L,2): INPUT  "New Beginning Event Number  ";              A(L,1)
  95. 880 INPUT "New Ending Event Number"; A(L,2):INPUT "New Optimistic End  ";A(L,3)
  96. 890 INPUT "New Likely End  ";A(L,4):INPUT "New Pess. End  ";A(L,5)
  97. 900 GOTO 620
  98. 905 MSG$ ="Want hard copy of your data  ":LGTH=1:GOSUB 10000:P$=ANSWER$:            IF P$<>"Y" AND P$<>"y" THEN 1040
  99. 910 MSG$="Title ":LGTH=40:GOSUB 10000:T$=ANSWER$: LPRINT CHR$(14);"TITLE:  ";T$
  100. 920 LPRINT CHR$(14);"DATE: ";DATE$
  101. 930 LPRINT "NO "; Z3$
  102. 940 LPRINT "   "; Z4$
  103. 950 FOR I=1 TO M%
  104. 960 LPRINT USING C4$;I;
  105. 970 LPRINT USING C2$;A$(I,1),A$(I,2);
  106. 980 FOR J=1 TO 2
  107. 990 LPRINT USING C1$;A(I,J);:NEXT J
  108. 1000 FOR J=3 TO 5
  109. 1010 LPRINT USING C3$;A(I,J);:NEXT J
  110. 1020 LPRINT " "
  111. 1030 NEXT I
  112. 1040 MSG$="HIT ANY KEY TO COMPUTE RESULTS":LGTH=1:GOSUB 10000
  113. 1045 LOCATE 25,2: PRINT "WAIT.....";
  114. 1050 FOR I=1 TO M%
  115. 1060 A(I,6)=(A(I,3)+4*A(I,4)+A(I,5))/6
  116. 1070 IF A(I,1)=1 THEN A(I,7)=0:A(I,8)=A(I,6):GOTO 1110
  117. 1080 MAX = 0!
  118. 1090 FOR J= 1 TO M%
  119. 1092 IF A(J,2)<> A(I,1) THEN 1098
  120. 1094 IF A(J,8)> MAX THEN MAX = A (J,8)
  121. 1096 A(I,7)=MAX
  122. 1098 NEXT J
  123. 1100 A(I,8)=A(I,7)+A(I,6)
  124. 1110 NEXT I
  125. 1120 ' Backward pass?
  126. 1130 XM = 0!
  127. 1140 FOR I= M% TO 1 STEP -1
  128. 1150 IF A(I,2)<>EE THEN 1170
  129. 1160 IF XM<A(I,8) THEN XM = A(I,8)
  130. 1170 NEXT I
  131. 1180 FOR I=M% TO 1 STEP -1
  132. 1190 IF A(I,2)= EE THEN A(I,10)= XM: GOTO 1260
  133. 1200 MIM =999999!
  134. 1210 FOR J= M% TO 1 STEP -1
  135. 1220 IF A(I,2)<>A(J,1) THEN 1250
  136. 1230 IF A(J,9)<MIM THEN MIM =A(J,9)
  137. 1240 A(I,10)=MIM
  138. 1250 NEXT J
  139. 1260 A(I,9)=A(I,10)-A(I,6)
  140. 1270 NEXT I
  141. 1280 ' Slack Variable Calculations
  142. 1290 FOR I=1 TO M%
  143. 1300 A(I,11)=A(I,10)-A(I,8)
  144. 1310 NEXT I
  145. 1320 CLS:K=0        'PRINT OUTPUT
  146. 1325 COLOR 14,0,0:PRINT TAB(35);"RESULTS":PRINT:COLOR 7,0,0
  147. 1330 PRINT "Code       Description        Expected  Early   Early   Last   Last  Slack"
  148. 1340 PRINT "                               Time     Start   Fin.    Start  Fin.   Time"
  149. 1350 C5$=" ###.## "
  150. 1360 FOR I=1 TO M%
  151. 1365 IF A(I,11)=0 THEN COLOR 4 ELSE COLOR 7
  152. 1370 PRINT USING C2$;A$(I,1),A$(I,2);
  153. 1380 FOR J=6 TO 11
  154. 1390 PRINT USING C5$;A(I,J);:NEXT J
  155. 1400 PRINT:K=K+1:IF K=20 THEN MSG$="Enter to Page  ":LGTH=1:GOSUB 10000:ANSWER$      =DU$:K=0
  156. 1410 NEXT I
  157. 1420 MSG$="Hard Copy of Results  (Y/N)  ":LGTH=1:GOSUB 10000:P$=ANSWER$:               IF P$<>"y" AND P$<>"Y" THEN 1490
  158. 1430 LPRINT " ":LPRINT Z1$:LPRINT Z2$
  159. 1440 FOR I= 1 TO M%
  160. 1450 LPRINT A$(I,1);"   ";:LPRINT USING C2$;A$(I,2);
  161. 1460 FOR J=6 TO 11
  162. 1470 LPRINT USING C5$;A(I,J);:NEXT J
  163. 1480 LPRINT "   ":NEXT I
  164. 1490 CLS: COLOR 15,0,0:LOCATE 5,30: PRINT "OUTPUT MENU" :COLOR 7,0,0
  165. 1500 COLOR 4:LOCATE 7,20:PRINT "C - Critical Path and Time":COLOR 6
  166. 1510 LOCATE 8,20: PRINT "D - Disk":COLOR 1
  167. 1520 LOCATE 9,20: PRINT "E - END ":COLOR 7
  168. 1530 LOCATE 10,20: PRINT "R - Recycle"
  169. 1540 LOCATE 20,35: COLOR 15,0,0: INPUT "Choice, please...  ";OP$:IF OP$="R"             OR OP$="r" THEN 530
  170. 1550 IF OP$<>"C" AND OP$<>"c" THEN 1720
  171. 1560 'Identification of critical path and costs
  172. 1570 CO=0:PATH$=" ":SI=0
  173. 1580 FOR I=1 TO M%: IF A(I,11)>.000001 THEN 1600
  174. 1590 CO=CO+A(I,6):PATH$=PATH$+" "+A$(I,1):SI=SI+((A(I,3)-A(I,5))/6)^2
  175. 1600 NEXT I:C6$="###,###,###.##":SI=SQR(SI)
  176. 1610 CLS:LOCATE 5,30:COLOR 4,0,0:PRINT "CRITICAL PATH":PRINT PATH$:PRINT:               COLOR 7,0,0
  177. 1620 PRINT "Time of Critical Path  ":PRINT USING C6$;CO:INPUT "Scheduled Project Time (use same time units as data)   ";ST:Z=(ST-CO)/SI:XX=0
  178. 1630 BB$="Probability of being completed on time ": IF Z<0 THEN 1670
  179. 1640 A=.4361836:B=-.1201676:C=.937298: D=(2.7182818#^(-Z^2/2))*(2*3.1415926#)^            (-.5):E=(1+.3326*Z)^(-1):P=1#-D*(A*E+B*E^2+C*E^3):IF XX>0 THEN 1660
  180. 1650 COLOR 12,0,4:PRINT USING "Z= ##.###    ";Z;:PRINT BB$;:PRINT USING "#.###";P:              COLOR 7,0,3:GOTO 1680
  181. 1660 PRINT USING "Z= ##.###    ";-Z;:PRINT BB$;:PRINT USING "#.###";1-P:COLOR 7:           GOTO 1680
  182. 1670 XX=99: Z=-Z:GOTO 1640
  183. 1680 MSG$="Hard Copy (Y/N) ":LGTH=1:GOSUB 10000:P$=ANSWER$:                                   IF P$<>"y" AND P$<>"Y" THEN 1490
  184. 1690 LPRINT " ":LPRINT "CRITICAL PATH":LPRINT PATH$:LPRINT " ":LPRINT "Scheduled project time is  ";ST
  185. 1700 LPRINT "Time of critical path ":LPRINT USING C6$;CO: IF XX=0 THEN LPRINT "Z= ";         Z;"   ";BB$;P:GOTO 1490
  186. 1710 IF OP$="E" AND OP$="e" THEN END
  187. 1720 IF OP$<>"D" AND OP$<>"d" THEN 1770
  188. 1730 LINE INPUT "Name of disk:file ";X$:OPEN "O",1,X$
  189. 1740 PRINT#1,M%,EE
  190. 1750 FOR I=1 TO M%:PRINT#1,CHR$(34);A$(I,1);CHR$(34);",";CHR$(34);A$(I,2);              CHR$(34);A(I,1);A(I,2);A(I,3);A(I,4);A(I,5):NEXT I
  191. 1760 CLOSE #1: GOTO 1490
  192. 1770 SCREEN 0,0,0:WIDTH 80:COLOR 9,0,0:PRINT "ENDING...";:COLOR 7,0,0:                FOR I=1 TO 1000:NEXT: KEY ON:END
  193. 1775 DATA 18,9
  194. 1780 DATA "A","ACCT. PAPERS",1,2,1,2,3
  195. 1790 DATA "Z","PERMITS", 2,7,4,5,8
  196. 1800 DATA "B", "SHOP BANKERS", 1,3,2,4,6
  197. 1810 DATA "C","SHOP REAL EST.", 1,4,2,13,17
  198. 1820 DATA "D","MARKET STUDY", 2,3,2,4,5
  199. 1830 DATA "G","CONTRACTOR", 2,5,1.4,2.2,6.7
  200. 1850 DATA "H","ART PLANS", 3,5,2,4,6
  201. 1860 DATA "E","COST STUDY", 3,4,3,4,5
  202. 1870 DATA "I","LAND", 4,5,8,11,13
  203. 1880 DATA "J","MATERIAL", 5,6,2,3,4
  204. 1890 DATA "K","PLANS", 5,7,2,5,12
  205. 1900 DATA "L","SURVEY", 5,8,1,2,4
  206. 1910 DATA "M","BUY MAT #1", 6,8,2,3,4
  207. 1920 DATA "O","BUY MAT #2", 6,9,1,2,5
  208. 1930 DATA "N","LAYOUT", 7,8,9,11,12
  209. 1940 DATA "P","FOUNDATION", 8,9,1,3,6
  210. 1950 DATA "Q","HIRE CREW 2", 7,9, 1,2,3
  211. 1960 DATA "F","INSURANCE", 2,6,.4,1.3,1.5
  212. 10000 REM This subroutine saves the cursor position as ONCE (Col. or Y)
  213. 10010 REM and WAS (Row or X), locates the cursor on the 25th status line
  214. 10020 REM gets an input value (string only), and returns the cursor to
  215. 10030 REM where it ONCE WAS.
  216. 10040 REM             Input Variables = MSG$;Output = ANSWER$
  217. 10050 REM                               LGTH of desired ANSWER
  218. 10060 ' Store cursor position
  219. 10070   ONCE = CSRLIN
  220. 10080   WAS  = POS(0)
  221. 10085 ANSWER$=""        'empty the answer string
  222. 10090 ' Make sure softkeys are off, locate cursor on 25th line
  223. 10100   KEY OFF
  224. 10110   LOCATE 25,3
  225. 10120 ' Print the message the user requests and get an input
  226. 10130   PRINT MSG$;:ANSWER$=INPUT$(LGTH)
  227. 10150 ' Clear off the line for future use
  228. 10160   LOCATE 25,1:PRINT SPC(79);
  229. 10170 ' Restore the cursor to where it was
  230. 10180   LOCATE ONCE, WAS
  231. 10190   RETURN
  232. 15000 REM This subroutine does some error-checking, for instance, for the
  233. 15010 REM open statement in line 390
  234. 15020 REM It requires a ON ERROR GOTO 15000 statement at front of program
  235. 15025 MISTEAK=0:WHEREAT=0
  236. 15030 MISTEAK = ERR: WHEREAT=ERL
  237. 15040 IF MISTEAK = 55 THEN CLOSE:RESUME
  238. 15050 IF MISTEAK = 53 THEN PRINT"CAN'T FIND THAT FILE - CATALOG: ":COLOR 3:PRINT      "A:":FILES "A:*.*":COLOR 9:PRINT "B:":FILES "B:*.*":PRINT:PRINT"WAIT...":       FOR I= 1 TO 7000:NEXT I:RESUME 130
  239. 15060 IF MISTEAK = 61 THEN PRINT"DISK IS FULL - PLEASE GET ANOTHER:FOR I=1 TO         3000:NEXT I:RESUME 1730
  240. 15070 IF MISTEAK = 64 THEN PRINT"THAT'S NOT A GOOD FILE NAME-USE B:XXXXXXX.YYY":            FOR I=1 TO 3000:NEXT I:RESUME 130
  241. 15075 IF MISTEAK = 68 THEN PRINT "THAT DISK DOESN'T EXIST...USE A: OR B:":              FOR I=1 TO 3000:NEXT I: RESUME 130
  242. 15080 IF MISTEAK = 70 THEN PRINT "THE DISK IS WRITE-PROTECTED - CAN'T USE IT":          FOR I=1 TO 3000:NEXT I:RESUME 130
  243. 15090 IF MISTEAK = 71 THEN PRINT "CLOSE THE DISK DOOR":FOR I=1 TO 3000:NEXT I:          RESUME 130
  244. 15100 IF MISTEAK =72 THEN PRINT "I THINK THE DISK IS BAD":TRIES=TRIES+1:                IF TRIES<3 THEN RESUME ERL: ELSE PRINT "ENDING...CHECK DISK":                   FOR I=1 TO 3000:NEXT I:GOTO 1770
  245. 15105 IF MISTEAK =67 THEN PRINT "YOU HAVE TOO MANY FILES OPEN AT ONE TIME":             FOR I=1 TO 3000:NEXT I: RESUME 130
  246. 15110 ON ERROR GOTO 0: RESUME
  247. 20000 REM This subroutine switches the active and visual pages in SCREEN 0
  248. 20010 REM mode to page 1, thus allowing the programmer to put "help"
  249. 20020 REM material, ancillary input, or other messages on a "clean slate."
  250. 20022 ONCE = CSRLIN: WAS =POS(0)
  251. 20025 ABORT = 0
  252. 20030 SCREEN 0,1,1,1    'color burst, apage=1,vpage=1
  253. 20032 CLS
  254. 20035 KEY (1) ON
  255. 20037 ON KEY(1) GOSUB 22000
  256. 20040 LOCATE 25,1:COLOR 4:  PRINT "Hit <F1> key BEFORE entering to abort - I'll WAIT before going on";
  257. 20042 LOCATE 5,35: COLOR 3:PRINT "CHANGE ROUTINE":COLOR 9
  258. 20045 COLOR 9,8,0
  259. 20050 FOR I=1 TO 5000:NEXT I
  260. 20070 RETURN
  261. 22000 CLS:SCREEN 0,1,0,0
  262. 22010 ABORT=1
  263. 22015 IF ABORT AND XCHECK THEN M%=M%-1:N%=N%-1:XCHECK=0
  264. 22020 LOCATE ONCE,WAS
  265. 22030 RETURN
  266. 30000 GOTO 20070
  267. 30010 RETURN
  268.